#!/usr/bin/perl

# NZB Rar Explorer : http://code.google.com/p/nzb-rar-explorer/
# Version 0.1 - 2013 04
# by binarydust

# use module
use XML::Simple;
use News::NNTPClient;
use Data::Dumper;
use Sort::Naturally;
use Switch;
use strict;
use IO::Handle;
STDOUT->autoflush(1);

# CONFIG #
my $ulogin = 'login';
my $upass = 'password';
my $nnserv = 'news.server.net';
my $nnport = 119; # SSL is not supported
my $tmpdir = "./tmp";
my $debug = 0; # 0 = none - 1 = basic part processing info - 2 = more processing info - 3 = full file info
my $display = 0; # resulsts display type : 0 (by files found), 1 by archives

# Ctrl-C
my $toexit = 0;
$SIG{'INT'} = sub { print "\nWARNING: Exiting.\n"; $toexit=1; };

if ( ! -d "$tmpdir" ) { die "Temp directory \"$tmpdir\" not found check the script config !\n"; }
if ( ! -e $ARGV[0] ) { die "Nzb file not found !\n"; }

my $xml = new XML::Simple (KeyAttr=>{segment => "+number"},ForceArray=>["file","segment"]);


# read XML file
print "Loading nzb, please wait. ";

my $data = $xml->XMLin("$ARGV[0]"); # or die "Nzb XML parsing error, check your nzb file.\n";

my $conn = new News::NNTPClient($nnserv,$nnport);
$conn->authinfo($ulogin,$upass);
if ( $conn->code ne "281" ) {
	print "\nERROR: Usenet server authentication failure :\n",$conn->code," : ",$conn->message," Exiting.\n";
	exit;
}

print $#{$data->{file}}+1," entries found.\n";

my %rarlist; # { @rarX=>[ file1=>@array(), file2=>array(), ..], @rarY=>[file1=>@array(), ..], ... }
my $tmpyydec = "yydec.rar";
my $rarcom = "rar vt $tmpdir/$tmpyydec 2>&1";
my $yydcom = "yydecode -f -b -o $tmpdir/$tmpyydec $tmpdir/*.part 2>&1";

my $o=-1;	
my $pdowncnt = 0; # stats : total number of parts downloaded
my $pdatadown = 0; # stats : total data downloaded
my $filescount = 0; # stats : total number of files found

# process <file> entries
# sorting does not really matter when processing entries, it lets the user see the archives in order and stop the process if deemed safe
foreach my $f ( sort { ncmp($a->{subject},$b->{subject}) } @{$data->{file}} ) 
{	
	my $rsize=0;
	my $psize = 0; # parts size
	my $rname='';
	my $curpart = 1;
	my $fsub = $f->{subject};
	my $fsubname = ( $fsub =~ /\"([^\"]+\.[^\"]+)\"/ ) ? $1 : $fsub;
	my $partcount = ( $fsub =~ /yEnc[^\d]*\d+[^\d]+(\d+)/i ) ? $1+0 : keys $f->{segments}->{segment};
	my $done = 0;
	my $trynextpart = 1; # default next header part offset = +1, other offsets are -1 and -2 (relative to initial +1), then +2 (relative to absolute next header part offset) and +3 and then give up
	my $filesfound = -1; # used to compare previous 
	
	my @filelist = ();
	my $mess = '';
	my $warnattrib = 0; # not used - file attributes count error
	my $corheader = 0; # not used - " - the file header is corrupt" message, should produce an attrib count error
	

	last if ( $toexit == 1 );
	
	print( "\nProcessing archive : $fsubname.\n");
	pdebug(1,"parts count=$partcount");
	
	# delete temp files
	unlink glob "$tmpdir/*.part";
	unlink "$tmpdir/$tmpyydec";
		
	while ( $done == 0 ) {
		if ( $debug==0 && $curpart==1 ) { print "Please wait ."; }
		elsif ( $debug==0 ) { print "."; }
				
		if ( $toexit == 1 ) { 
			$done=9;
		
		# part found
		} elsif ( $f->{segments}->{segment}->{$curpart} ) {
			pdebug(1,"processing part $curpart : ", $f->{segments}->{segment}->{$curpart}->{content});
		
			open (F, ">$tmpdir/$curpart.part") or die "ERROR: coulnd not create part file.\n";
			print F $conn->body("<".$f->{segments}->{segment}->{$curpart}->{content}.">")  or die "ERROR: could not write part data.\n";
			close (F);
			if ( $conn->code ne "222" ) {
				print "ERROR: part $curpart could not be downloaded.\n",$f->{segments}->{segment}->{$curpart}->{content},"\n";
				$done=3;
			} else {
				# stats
				$pdowncnt++;
				pdebug(1,"processing part $curpart data");
				
				# Process part1
				if ( $curpart == 1 ) {
					pdebug(1, "processing part $curpart=1 header");
					
					my $i=0;
					open (F, "<$tmpdir/$curpart.part") or die "ERROR: coulnd not open part (1) file.\n";
					while ( <F> ) {
						pdebug(1, "$_");
						chomp;
						if (/^=ybegin/i) { 		
							if (/size=(\d+)/i) { $rsize=$1+0; pdebug(2, "Volume size = $rsize"); }
							if (/name=(.+\..+)/i) { $rname=$1; pdebug(2, "Volume name = \"$rname\""); }
							$i++;
							next;
						}
						if (/^=ypart/i) {
							if ( /end=(\d+)/i ) { 
								$psize=$1+0;  pdebug(2, "Part size = $psize");
							}
					        last;
						}
						$i++;
						last unless ( $i<10 );
					}
					close (F);
					
					pdebug(1, "achive info : post subject=\"$fsub\"\nDEBUG: found vol name=\"$fsubname\"");
					pdebug(1, "yenc part size=$psize - yenc vol size=$rsize - yenc vol name=\"$rname\"");
					
					if ( $rname eq "" ) {
						pdebug(1, "yenc vol name not found, using substitute : \"$fsubname\"");
						$rname=$fsubname;
					}
					
					if ( $psize == 0 ) {
						print "ERROR: part size not found, can't continue file, skipping.\n";
						$done=4;
					}
				}
				
				# stats
				$pdatadown += $psize;
				
				# Decode yenc part
				pdebug(1, "processing yydecode command.");
				my @yydout = `$yydcom`;
				$_ = pop(@yydout);
				pdebug(2, "$_");
				if ( ! /wrote \d+ bytes/i ) {
					print "ERROR: yydecode failed, can't continue, skipping file.\n";
					$done=5;
				}
				
				# Parse rar list output
				pdebug(1, "processing rar list command.");
				
				my @rarout = `$rarcom`;
				
				my $in = 0;
				my $first=0;				
				my @attrib = ();
				my $filename = '';
				$mess = '';
				@filelist = ();

				foreach ( @rarout ) {
						s/[\s\n\r]+$//;						
						next if ( $_ eq '' );
						if ( /is not RAR archive/ ) {
							print "ERROR: this is not a rar archive, skipping file.\n";
							$done=7;
							last;
						}
						if (/^-----/ && $first == 0) { $first = 1; $in = !$in; next; }
						next if ( !$in );
						if (/^ [^\s]/) {	    
							# Store previous file data
							if ( $filename ne '' ) {
								pdebug(3, "file found : \"$filename\"");
								pdebug(3, "file data : " . join(" - ",@attrib[1..$#attrib]));
								# go last if corrupt header found
								if ( $filename =~ /file header is corrupt/ ) {
									$corheader = 1; # useless
									pdebug(2,"\"file header is corrupt\" message found, trying another part.");									
									last;
								}
								# detect erroneous file attributes, flag and report
								if ( $#attrib != 12 && !$warnattrib ) {
									print "ERROR: file attributes count (", $#attrib+1, ") is different form the expected amount (13)\n";
									print $filename,"\n";
									print join(" - ",@attrib[1..$#attrib]),"\n";
									print "this file will be ignored.\n";
									$warnattrib = 1;									
								}
								if ( $#attrib == 12 ) {
									push @filelist, [ @attrib ];
								}
								@attrib=();
								$filename='';
							}							
							s/(^\s+)|(\s+$)//;
							$filename=$_;
							push @attrib, $filename;
							pdebug(3, "new file : \"$filename\"");
						} elsif (/^\s+/) {
							push @attrib, split;
						} else {
							pdebug(3, "file found : \"$filename\"");
							pdebug(3, "file data : " . join(" - ",@attrib[1..$#attrib]));
							# go last if corrupt header found
							if ( $filename =~ /file header is corrupt/ ) {
								$corheader = 1; # useless
								pdebug(2,"\"file header is corrupt\" message found, trying another part.");									
								last;
							}
							# detect erroneous file attributes, flag and report
							if ( $#attrib != 12 && !$warnattrib ) {
								print "ERROR: file attributes count (", $#attrib+1, ") is different form the expected amount (13)\n";
								print $filename,"\n";
								print join(" - ",@attrib[1..$#attrib]),"\n";
								print "this file will be ignored.\n";
								$warnattrib = 1;
							}
							if ( $#attrib == 12 ) {
								push @filelist, [ @attrib ];
							}
							
							$mess = $_;
							pdebug(1, "rar list output last message : $mess");
							last;
						}
				}
				
				# Process last file entry - calculate parts jump or move to next file
				if ( $#filelist > -1 ) {
					# make sure we have found a new header part
					if ( $#filelist > $filesfound ) {
						$filesfound = $#filelist;
						pdebug(1,"new files count = $filesfound (try=$trynextpart)");
						
						# make sure we're not at the end
						if ( $filelist[$#filelist][3] =~ /->$/ || $curpart >= $partcount ) {
							$done=1; 
							pdebug(1, "end of volume, process data and proceed with next rar.");
						} else {							
							my $nextpart = int( $filelist[$#filelist][2] / $psize );							
							$curpart = $curpart + $nextpart;
							if ( $curpart < $partcount ) {
								$trynextpart = 1;								
								$curpart = $curpart + 1;
							} else {
								$trynextpart = -1;	 # fake a -1 try, although +1 was not run.
							}
							pdebug(1, "next part $curpart, is at byte ".$filelist[$#filelist][2]." or +$nextpart parts.");
							next;
						}
					} else {
						pdebug(1,"files count = $filesfound");
						# give up if all offsets have been tried
						if ( $trynextpart == 3 ) {
							$done=6;
							print "ERROR: all offsets tried, no new header found, giving up. Next file.\n";
						} else {
							# last part didn't bring any new header try -1 / -2
							if ( $trynextpart == 1 ||  $trynextpart == -1 ) {
								$trynextpart = ( $trynextpart == 1 ) ? -1 : -2;
								$curpart = $curpart - 1;
						} else {
								$trynextpart = ( $trynextpart == -2 ) ? 2 : 3;
								if ( $trynextpart == 2 ) { $curpart = $curpart + 3; }
								if ( $trynextpart == 3 ) { $curpart = $curpart + 1; }
							}
							pdebug(1, "trying new offset=$trynextpart, curpart=$curpart.");
							next;
						}
					}
				} else {
					if ( $done == 0 ) {
						print "ERROR: unknown file processing error, skipping file.\n";
						$done=8;
					}
				}
			}
		
		# part not found
		} else {
			print "ERROR : part $curpart not found, cannot continue, skipping file.\n"; 
			$done=2;
		}	
		
		# Process archhive files data
		if ( $done > 0 ) {
			if ( $debug==0 ) { print "\n"; }
			
			$filescount += $#filelist+1;
			
			pdebug(1, "done=$done processing file data: ");
			
			unshift @filelist, [ $done, $mess ];
			
			if ( exists $rarlist{$rname} ) {
				print "WARNING: archive name present multiple times in your nzb, this name will be seen as separate archives.\n";
				my $i=0;
				$rname .= "_".$i;
				while ( exists $rarlist{$rname} ) {
					$i++;
				}
				print "WARNING: new name = ".$rname."\n";
			}
			$rarlist{$rname} = [ @filelist ];
			if ( $done != 7 ) {
				print "Files found in archive :\n";
				for my $i ( 1 .. $#filelist ) {
					my @file = @{ @filelist[$i] };
					print @file[0],"\n";
				}
			}
		}
	}
}


# Cleanup
unlink glob "$tmpdir/*.part";
unlink "$tmpdir/$tmpyydec";


# Output Results
# display by file (default)
if ( $display == 0 ) {
	print "\n\nPrinting Files list :\n";
		
	# create files list
	my %files;
	foreach my $key ( nsort keys %rarlist ) {
		my @filelist = ();
		push @filelist, @{ $rarlist{$key} };
		
		for my $i ( 1 .. $#filelist ) { # 1 .. = skip archive status
			my @file = @{ @filelist[$i] };
			my $status = ( @file[3] =~ '%' ) ? 'FULL' : (( @file[3] =~ '<--' ) ? 'LAST' : (( @file[3] =~ '-->' ) ? 'FIRST' : 'part') );
			if ( @file[6] =~ /.....A./ || @file[6] =~ /^-/ ) {
				if ( ! exists $files{@file[0]} ) {
					my $filename = @file[0];
					unshift @file, [ $key ." ($status)" ];
					$files{$filename} = [ @file ];
				} else {
					my @entry = @{$files{@file[0]}};
					push @{@entry[0]}, $key ." ($status)";
					$files{@file[0]} = [ @entry ];
				}
			}
		}
	}
	
	foreach my $key ( nsort keys %files ) {
		my @file = @{ $files{$key} };
		print "\nFile: ".$key."\nSize: ".( ((@file[2] / 1024)>1024 ) ? sprintf('%.2f',(@file[2]/1024/1024))."MB" : sprintf('%.2f',(@file[2] / 1024))."KB" )." - Date: ".@file[5]."\n";
		print join( "\n", @{@file[0]}), "\n";
	}	


# display by archive
} else {
	print "\n\nPrinting Archives list :\n";

	foreach my $key ( nsort keys %rarlist ) {
		print "\nArchive Name : $key\n";
		my $status=0;
		my @filelist = ();
		push @filelist, @{ $rarlist{$key} };
		for my $i ( 0 .. $#filelist ) {
			my @file = @{ @filelist[$i] };
			if ( !$status ) {
				$status=1;
				print "Status : ",archstatus(@filelist[0]),".\n";
			} else {
				# test flags, skip directory entries
				if ( @file[6] =~ /.....A./ || @file[6] =~ /^-/ ) {
					print "File: ".@file[0]."\nSize: ".( ((@file[1] / 1024)>1024 ) ? sprintf('%.2f',(@file[1]/1024/1024))."MB" : sprintf('%.2f',(@file[1] / 1024))."KB" )." - Date: ".@file[4]."\n";
				}				
			}
		}
	}

}

# Stats

print "Stats : $filescount files found.\n$pdowncnt parts downloaded (", sprintf('%.2f',($pdatadown / 1024))."KB", ").\n";


# functions
sub archstatus() {
			my $ret;
			switch (shift) {
				case 1 { $ret .= "archive completed"; }
				case 2 { $ret .= "missing part from nzb file, skipped archive remaining parts"; }
				case 3 { $ret .= "part download error, skipped archive remaining parts"; }
				case 4 { $ret .= "part size not found, skipping archive"; }
				case 5 { $ret .= "yydecode failed, skipped archive remaining parts"; }
				case 6 { $ret .= "new header not found, giving up, skipped archive remaining parts"; }
				case 7 { $ret .= "this is not a rar archive, skipping file"; }
				else { $ret .= "WARNING: Unknown status"; }
			}	
		return $ret;
}

sub pdebug() {
	if ( $debug >= shift ) { print "DEBUG: ".$_."\n" for @_ };
}
